home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / colors.arc / COLORS.INC < prev    next >
Encoding:
Text File  |  1985-12-19  |  1.5 KB  |  72 lines
  1. const
  2.   _6845_Index = $3D4 ;
  3.   _6845_Data  = $3D5 ;
  4.   ModeControl = $3D8 ;
  5.   MaxC        = 6 ;
  6.  
  7. var
  8.   c         :char ;
  9.   screen    : array[0..7999,0..1] of byte absolute $B000:$8000 ;
  10.   screeni   : array[0..7999] of integer absolute $B000:$8000 ;
  11.   hue       : array[0..MaxC,0..MaxC,0..MaxC] of byte ;
  12.   inten     : array[0..MaxC,0..MaxC,0..MaxC] of byte ;
  13.   colorfile : file of byte ;
  14.  
  15. procedure SetColors ;
  16. var
  17.   r,g,b : integer ;
  18. begin
  19.   assign(colorfile,'COLOR.DAT');
  20.   reset(colorfile) ;
  21.   for r := 0 to MaxC do
  22.   begin
  23.     for g := 0 to MaxC do
  24.     begin
  25.       for b := 0 to MaxC do
  26.       begin
  27.         read(colorfile,hue[r,g,b]   );
  28.         read(colorfile,inten[r,g,b])  ;
  29.       end ;
  30.     end ;
  31.   end ;
  32.   Close(ColorFile) ;
  33. end ;
  34.  
  35. procedure VideoReg(reg,data:integer) ;
  36. begin
  37.   Port[_6845_Index]:=reg ;
  38.   Port[_6845_Data] :=data;
  39. end ;
  40.  
  41. procedure NoBlink ;
  42. begin
  43.   Port[ModeControl] := 9 ;
  44. end ;
  45.  
  46. procedure MultiColor ;
  47. begin
  48.   SetColors ;
  49.   TextMode(C80) ; {put into 80 colomn color mode}
  50.   VideoReg(4,$7F); {increase total lines to 255}
  51.   VideoReg(6,$64); {increase displayed lines to 200}
  52.   VideoReg(7,$70); {change sync position}
  53.   VideoReg(9,$03); {change to 4 scan lines high}
  54.   NoBlink ;
  55. end ;
  56.  
  57. procedure NormalColor ;
  58. begin
  59.   TextMode(C40) ;
  60.   TextMode(C80) ;
  61. end ;
  62.  
  63. function Shade(c:integer;n:real):integer ;
  64. var
  65.   sh : integer ;
  66. begin
  67.   Sh := c+round(abs((MaxC/2)-c)*n) ;
  68.   if (sh<0) then shade := 0 else
  69.   if (sh>MaxC) then shade:=MaxC else
  70.   shade := sh ;
  71. end ;
  72.